home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nerdbowl.zip / NB.PAS < prev   
Pascal/Delphi Source File  |  1992-06-02  |  20KB  |  782 lines
  1. Program NerdBowl;       {written by Kevin Hellman for A.P. Final Exam}
  2. { This is an unfinished program for those who want to create any type 
  3. of soccer game.  Hopefully you can get an idea from it.  This program
  4. was orginally given as a final exam problem for Homestead advanced
  5. placement computer science.  Every year the advanced placement class
  6. plays the Computer Science II class soccer- THE NERDBOWL.  The assignment
  7. was to create a nerdbowl program.  Feel free to use any of my code
  8. for anything- but if you do a piece of E-Mail would be nice.  }
  9. USES CRT;
  10. Type
  11.   it = record
  12.    x,y,xv,yv:integer;
  13.   end;
  14.  
  15.   Player = record  {this is a user defined record}
  16.    Name:string[20]; {this user defined type can be printed}
  17.    Rating: set of (Sh_t,Bad,OK,Good,Great); {this user defined
  18.                                             type/ SET can not be printed}
  19.    Endurance:integer;
  20.    Injurys  :integer;
  21.    Ability  :integer;
  22.    Goals    :integer;
  23.    AP       :integer;
  24.   End;
  25.  
  26.  Linkedplayerlist =record
  27.   Person:player;
  28.   Nextperson:^player;
  29.   end;
  30. Var
  31.  APCSTEAM   : array[1..20] of Player;{these are two parallel arrays}
  32.  CSIITEAM   : array[1..20] of player;
  33.  APCSPlayers:integer;
  34.  CSIIPlayers:integer;
  35.  SortedLists:Array[1..40,1..5] of player;
  36.  PlayerList:array[1..40] of LinkedPlayerlist;
  37.  APCSSCORE:integer;
  38.  CSIISCORE:integer;
  39.  TeamLoaded:boolean;
  40.  Screen   :array[1..80,1..25] of char;
  41.  Ball:it;
  42.  
  43. Procedure Initialize;
  44. begin
  45.  APCSPLAYERS:=0;
  46.  CSIIPLAYERS:=0;
  47.  APCSSCORE:=0;
  48.  CSIISCORE:=0;
  49. end;
  50.  
  51. Procedure ReScreen;
  52. var
  53.  x,y:integer;
  54. begin
  55.   for x:=1 to 80 do for y:=1 to 25 do Screen[x,y]:=' ';
  56.   for X:=1 to 80 do screen[X,1]:='=';
  57.   for X:=1 to 80 do screen[X,16]:='=';
  58.   For y:=1 to 16 do screen[1,y]:='║';
  59.   For y:=1 to 16 do screen[80,y]:='║';
  60.   for y:=6 to 10 do Screen[2,y]:='[';
  61.   for y:=6 to 10 do Screen[79,y]:=']';
  62. end;
  63.  
  64.  
  65. Procedure DumpScreen;
  66. var
  67.  x,y:integer;
  68. begin
  69.  clrscr;
  70.  for y:=1 to 23 do for x:=1 to 80 do write(screen[x,y]);
  71.  WRITELN('AP:',apcsscore,'  CSII:',csiiscore);
  72. end;
  73.  
  74. Procedure Help;
  75. var
  76.  c:integer;
  77. begin
  78.  For c:=1 to 25 do writeln;
  79.  WRITELN('        ▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌NERD BOWL▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌');
  80.  WRITELN;
  81.  WRITELN('THIS IS A NERD BOWL SIMULATION CREATED BY KEVIN HELLMAN ON');
  82.  WRITELN('5/31/92 FOR HIS APCS FINAL EXAM.  ENJOY.................. ');
  83.  WRITELN('KEYS');
  84.  WRITELN('ARROW KEYS ARE FOR MOVEMENT');
  85.  WRITELN('+ KICKS THE BALL');
  86.  WRITELN('- PASSES THE BALL');
  87.  WRITELN('* VIOLENCE BUTTON');
  88.  READLN;
  89. end;
  90.  
  91. Procedure AddAPPlayer;
  92. begin
  93.  APCSPLAYERS:=APCSPLAYERS+1;
  94.  writeln;
  95.  Write('Name:');
  96.  Readln(APCSTEAM[APCSPLAYERS].NAME);
  97.  Write('Endurance:');
  98.  Readln(APCSTEAM[APCSPLAYERS].Endurance);
  99.  Write('Ability:');
  100.  Readln(APCSTEAM[APCSPLAYERS].Ability);
  101.  Write('Goals:');
  102.  Readln(APCSTEAM[APCSPLAYERS].Goals);
  103.  APCSTEAM[APCSPLAYERS].AP:=1;
  104. end;
  105.  
  106. Procedure AddCSPlayer;
  107. begin
  108.  CSIIPLAYERS:=CSIIPLAYERS+1;
  109.  writeln;
  110.  Write('Name:');
  111.  Readln(CSIITEAM[CSIIPLAYERS].NAME);
  112.  Write('Endurance:');
  113.  Readln(CSIITEAM[CSIIPLAYERS].Endurance);
  114.  Write('Ability:');
  115.  Readln(CSIITEAM[CSIIPLAYERS].Ability);
  116.  Write('Goals:');
  117.  Readln(CSIITEAM[CSIIPLAYERS].Goals);
  118.  CSIITEAM[APCSPLAYERS].AP:=0;
  119. end;
  120.  
  121. Procedure EditDatabase;
  122. var
  123.  temp:integer;
  124. Begin
  125.  FOR temp:=1 to 25 do Writeln; {fixed repetition loop}
  126.  WRITELN('        ▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌Edit Data Base Menu▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌');
  127.  Writeln('        [1]....................Add APCS Player');
  128.  Writeln('        [2]....................Add CSII Player');
  129.  Writeln('        [3]....................Return ');
  130.  Write('Please enter a choice [1..3]:');
  131.  Readln(temp);
  132.  Case temp of {Here is a case statement}
  133.     1:  AddAPPlayer;
  134.     2:  AddCSPLAYER;
  135.     3:  exit;
  136.      else
  137.     editDatabase;
  138.     end;
  139. Editdatabase
  140. end;
  141.  
  142. Procedure LoadDatabase;
  143. var
  144.  F:text;
  145.  Temp:integer;
  146. begin
  147.  Assign(F,'Players.TXT');
  148.  APCSPLAYERS:=0;
  149.  CSIIPLAYERS:=0;
  150.  Reset(F);
  151.  Repeat 
  152.  Readln(F,temp);
  153.   if temp=1 then
  154.      begin
  155.       APCSPLAYERS:=APCSPLAYERS+1;
  156.       Readln(F,APCSTEAM[APCSPLAYERS].NAME);
  157.       Readln(F,APCSTEAM[APCSPLAYERS].Endurance);
  158.       Readln(F,APCSTEAM[APCSPLAYERS].Ability);
  159.       Readln(F,APCSTEAM[APCSPLAYERS].Goals);
  160.       APCSTEAM[APCSPLAYERS].AP:=1;
  161.      end
  162.       else
  163.      begin
  164.       CSIIPLAYERS:=CSIIPLAYERS+1;
  165.       Readln(F,CSIITEAM[CSIIPLAYERS].NAME);
  166.       Readln(F,CSIITEAM[CSIIPLAYERS].Endurance);
  167.       Readln(F,CSIITEAM[CSIIPLAYERS].Ability);
  168.       Readln(F,CSIITEAM[CSIIPLAYERS].Goals);
  169.       CSIITEAM[CSIIPLAYERS].AP:=0;
  170.      end;
  171.    until eof(F);
  172.   CLOSE(F);
  173. end;
  174.  
  175. Procedure SaveDatabase;
  176. var
  177.  F:text;
  178.  Temp:integer;
  179. begin
  180.  Assign(F,'Players.TXT');
  181.  Rewrite(F);
  182.  For temp:=1 to APCSPLAYERS do
  183.   begin
  184.        Writeln(F,1);
  185.        Writeln(F,APCSTEAM[temp].NAME);
  186.        Writeln(F,APCSTEAM[temp].Endurance);
  187.        Writeln(F,APCSTEAM[temp].Ability);
  188.        Writeln(F,APCSTEAM[temp].Goals);
  189.      end;
  190.  
  191.  For temp:=1 to CSIIPLAYERS do
  192.      begin
  193.       Writeln(F,0);
  194.       Writeln(F,CSIITEAM[temp].NAME);
  195.       Writeln(F,CSIITEAM[temp].Endurance);
  196.       Writeln(F,CSIITEAM[temp].Ability);
  197.       Writeln(F,CSIITEAM[temp].Goals);
  198.      end;
  199.     Close(F);
  200. end;
  201.  
  202. Procedure SeeAP;
  203. var
  204.  I,J:integer;
  205.  Low,High:integer;
  206.  SLow:string;
  207. begin
  208.   Low:=1;
  209.   For I:=1 to APCSplayers do
  210.    if APCSTEAM[I].NAME<APCSTEAM[LOW].NAME then
  211.       LOW:=I;
  212.       High:=low;
  213.   playerlist[1].Person:=apcsteam[LOW];
  214.  
  215.   For J:=2 to Apcsplayers do  {SORTS THE PLAYERS}
  216.    begin
  217.     Slow:='ZZZZZ';
  218.      For I:=1 to apcsplayers do
  219.       if (APCSTEAM[I].NAME<Slow) and (APCSTEAM[I].NAME >APCSTEAM[HIGH].NAME) then
  220.        begin
  221.         LOW:=I;
  222.         Slow:=APCSTEAM[I].NAME;
  223.        end;
  224.       High:=low;
  225.     playerlist[J].Person:=apcsteam[LOW];
  226.   end;
  227.  
  228. WRITELN;
  229. WRITELN;
  230. WRITELN('NAME                Endurance           Ability              Goals');
  231. Writeln('----                ---------           -------              -----');
  232. For I:=1 to Apcsplayers do
  233. begin
  234. WRITE(playerlist[I].PERSON.NAME);
  235. For J:=1 to 20-length(playerlist[I].PERSON.NAME) do
  236.  write(' ');
  237. WRITE(playerlist[I].PERSON.ENDURANCE,'                    ');
  238. WRITE(playerlist[I].PERSON.Ability,  '                    ');
  239. WRITEln(playerlist[I].PERSON.Goals);
  240. end;
  241. READLN;
  242. end;
  243.  
  244. Procedure SeeCS;
  245. var
  246.  I,J:integer;
  247.  Low,High:integer;
  248.  SLow:string;
  249. begin
  250.   Low:=1;
  251.   For I:=1 to CSIIplayers do
  252.    if CSIITEAM[I].NAME<CSIITEAM[LOW].NAME then
  253.       LOW:=I;
  254.       High:=low;
  255.   playerlist[1].Person:=csIIteam[LOW];
  256.  
  257.   For J:=2 to csiiplayers do  {SORTS THE PLAYERS}
  258.    begin
  259.     Slow:='ZZZZZ';
  260.      For I:=1 to csiiplayers do
  261.       if (CSiiTEAM[I].NAME<Slow) and (CSiiTEAM[I].NAME >CSiiTEAM[HIGH].NAME) then
  262.        begin
  263.         LOW:=I;
  264.         Slow:=CSIITEAM[I].NAME;
  265.        end;
  266.       High:=low;
  267.     playerlist[J].Person:=csiiteam[LOW];
  268.   end;
  269.  
  270. WRITELN;
  271. WRITELN;
  272. WRITELN('NAME                Endurance           Ability              Goals');
  273. Writeln('----                ---------           -------              -----');
  274. For I:=1 to csiiplayers do
  275. begin
  276. WRITE(playerlist[I].PERSON.NAME);
  277. For J:=1 to 20-length(playerlist[I].PERSON.NAME) do
  278.  write(' ');
  279. WRITE(playerlist[I].PERSON.ENDURANCE,'                    ');
  280. WRITE(playerlist[I].PERSON.Ability,  '                    ');
  281. WRITEln(playerlist[I].PERSON.Goals);
  282. end;
  283. READLN;
  284. end;
  285.  
  286. Procedure Seeboth;
  287. var
  288.  X:integer;
  289.  I,J:integer;
  290.  Low,High:integer;
  291.  SLow:string;
  292. begin
  293.  For x:=1 to apcsplayers do
  294.   sortedlists[X,1]:=APCSTEAM[X];
  295.  For X:=1 to csIIplayers do
  296.   sortedlists[apcsplayers+X,1]:=CSIITEAM[X];
  297.  x:=APCSPLAYERS+CSIIPLAYERS;
  298.   Low:=1;
  299.   For I:=1 to X do
  300.    if SORTEDLISTs[I,1].NAME<SORTEDLISTs[LOW,1].NAME then
  301.       LOW:=I;
  302.       High:=low;
  303.   playerlist[1].Person:=sortedlists[LOW,1];
  304.  
  305.   For J:=2 to X do  {SORTS THE PLAYERS}
  306.    begin
  307.     Slow:='ZZZZZ';
  308.      For I:=1 to X do
  309.       if (Sortedlists[I,1].NAME<Slow) and (Sortedlists[I,1].NAME >Sortedlists[HIGH,1].NAME) then
  310.        begin
  311.         LOW:=I;
  312.         Slow:=SORTEDLISTs[I,1].NAME;
  313.        end;
  314.       High:=low;
  315.     playerlist[J].Person:=SORTEDLISTs[LOW,1];
  316.   end;
  317.  
  318. WRITELN;
  319. WRITELN;
  320. WRITELN('NAME                Endurance           Ability              Goals');
  321. Writeln('----                ---------           -------              -----');
  322. For I:=1 to X do
  323. begin
  324. WRITE(playerlist[I].PERSON.NAME);
  325. For J:=1 to 20-length(playerlist[I].PERSON.NAME) do
  326.  write(' ');
  327. WRITE(playerlist[I].PERSON.ENDURANCE,'                    ');
  328. WRITE(playerlist[I].PERSON.Ability,  '                    ');
  329. WRITEln(playerlist[I].PERSON.Goals);
  330. end;
  331. READLN;
  332. end;
  333.  
  334. Procedure DispStatistics;
  335. var
  336.  temp:integer;
  337. begin
  338.  FOR temp:=1 to 25 do Writeln; {fixed repetition loop}
  339.  WRITELN('        ▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌Stats Menu▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌');
  340.  Writeln;
  341.  Writeln('        [1]....................See APCS Team');
  342.  Writeln('        [2]....................See CSII Team');
  343.  Writeln('        [3]....................See Both Teams ');
  344.  Writeln('        [4]....................HELP');
  345.  Writeln('        [5]....................Return to Main Menu');
  346.  Writeln;
  347.  Write('Please enter a choice [1..6]:');
  348.  Readln(temp);
  349.  Case temp of {Here is a case statement}
  350.     1:  SeeAP;
  351.     2:  SeeCS;
  352.     3:  SeeBoth;
  353.     4:  Help;
  354.     5:  exit;
  355.      else
  356.     DispStatistics;;
  357.     end;
  358. DispStatistics;
  359. end;
  360.  
  361.  
  362. Procedure DataBaseMenu; {procedure with no parameters}
  363. var
  364.  Temp:integer;
  365. begin
  366.  FOR temp:=1 to 25 do Writeln; {fixed repetition loop}
  367.  WRITELN('        ▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌Data Base Menu▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌');
  368.  Writeln;
  369.  Writeln('        [1]....................Edit Database');
  370.  Writeln('        [2]....................Load Database');
  371.  Writeln('        [3]....................Save Database ');
  372.  Writeln('        [4]....................Display Statistics');
  373.  Writeln('        [5]....................HELP');
  374.  Writeln('        [6]....................Return to Main Menu');
  375.  Writeln;
  376.  Write('Please enter a choice [1..6]:');
  377.  Readln(temp);
  378.  Case temp of {Here is a case statement}
  379.     1:  EditDatabase;
  380.     2:  LoadDatabase;
  381.     3:  SaveDatabase;
  382.     4:  DispStatistics;
  383.     5:  Help;
  384.     6:  exit;
  385.      else
  386.     DatabaseMenu;
  387.     end;
  388. end;
  389.  
  390. Procedure GameMenu;
  391. begin
  392. end;
  393.  
  394. Procedure SimGame;
  395. begin
  396. end;
  397.  
  398. Procedure WatchGame;
  399. TYPE
  400.  PLACE = RECORD
  401.   X,Y:INTEGER;
  402.  END;
  403. VAR
  404.  APGUYS,CSGUYS:INTEGER;
  405.  APPOSITIONS: ARRAY[1..20] OF PLACE;
  406.  CSPOSITIONS: ARRAY[1..20] OF PLACE;
  407.  
  408. PROCEDURE INITPOSITIONS;
  409. VAR
  410.  c:INTEGER;
  411. BEGIN
  412.  FOR C:=1 TO APGUYS DO
  413.  BEGIN
  414.  APPOSITIONS[C].X:=38;
  415.  APPOSITIONS[C].Y:=C+1;
  416.  END;
  417.  FOR C:=1 TO CSGUYS DO
  418.  BEGIN
  419.  CSPOSITIONS[C].X:=41;
  420.  CSPOSITIONS[C].Y:=c+1;
  421.  END;
  422. END;
  423.  
  424. Procedure Apgoal;
  425. begin
  426. apcsscore:=apcsscore+1;
  427. clrscr;
  428. WRITELN('AP SCORES !');
  429. Delay(1000);
  430. ball.X:=30;
  431. ball.Y:=8;
  432. initpositions;
  433. end;
  434.  
  435. Procedure CSgoal;
  436. begin
  437. csIIscore:=csIIscore+1;
  438. clrscr;
  439. WRITELN('CS SCORES !');
  440. Delay(1000);
  441. ball.X:=70;
  442. ball.Y:=8;
  443. initpositions;
  444. end;
  445.  
  446. Procedure MoveBall;
  447. begin
  448. Ball.X:=(Ball.X+Ball.XV);
  449. Ball.Y:=Ball.Y+Ball.YV;
  450. Ball.XV:=Ball.XV div 2;
  451. Ball.YV:=Ball.YV div 2;
  452. if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  453. if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  454. if screen[ball.x,ball.y]='[' then Apgoal;
  455. if screen[ball.x,ball.y]=']' then CSgoal;
  456. screen[ball.x,ball.y]:='.';
  457. end;
  458.  
  459. Procedure Placemen;
  460. var
  461.  c:integer;
  462. begin
  463. For c:=1 to apguys do
  464.  screen[APPOSITIONS[C].X,APPOSITIONS[C].Y]:=chr(1);
  465. For c:=1 to csguys do
  466.  screen[CSPOSITIONS[C].X,CSPOSITIONS[C].Y]:=chr(2);
  467. end;
  468.  
  469. Procedure APMOVE;
  470. var
  471.  c:integer;
  472.  ox,oy:integer;
  473. begin
  474.  for c:=1 to APguys do
  475.  begin
  476.   ox:=appositions[c].X;
  477.   oy:=appositions[c].Y;
  478.   if ball.X+1<appositions[c].X then
  479.      appositions[c].X:=appositions[c].X-1-random((appositions[c].X- ball.X)div 2);
  480.   if ball.Y+1<appositions[c].Y then
  481.      appositions[c].Y:=appositions[c].Y-1-random((appositions[c].Y- ball.Y)div 2);
  482.   if ball.X-1>appositions[c].X then
  483.      appositions[c].X:=appositions[c].X+1+random(( ball.X  - appositions[c].X) div 2);
  484.   if ball.Y-1>appositions[c].Y then
  485.      appositions[c].Y:=appositions[c].Y+1+random(( ball.Y  - appositions[c].Y) div 2);
  486.   if (ABS(Ball.X-appositions[c].X)<2) and (abs(ball.y-appositions[c].y)<2)
  487.      then
  488.       begin
  489.      Ball.XV:=Ball.XV-random(4);
  490.      Ball.YV:=Ball.YV+random(4)-2;
  491.      if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  492.      if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  493.      end;
  494.  
  495.   if screen[appositions[c].x,appositions[c].y]<>' ' then
  496.    begin
  497.     appositions[c].X:=ox;
  498.     appositions[c].Y:=oy;
  499.   end;
  500.  placemen;
  501.  end;
  502. end;
  503.  
  504. Procedure CSMOVE;
  505. var
  506.  c:integer;
  507.  ox,oy:integer;
  508. begin
  509.  for c:=1 to CSguys do
  510.  begin
  511.   ox:=cspositions[c].X;
  512.   oy:=cspositions[c].Y;
  513.   if ball.X+1<cspositions[c].X then
  514.      cspositions[c].X:=cspositions[c].X-1-random((cspositions[c].X- ball.X)div 2);
  515.   if ball.Y+1<cspositions[c].Y then
  516.      cspositions[c].Y:=cspositions[c].Y-1-random((cspositions[c].Y- ball.Y)div 2);
  517.   if ball.X-1>cspositions[c].X then
  518.      cspositions[c].X:=cspositions[c].X+1+random((ball.X  - cspositions[c].X) div 2);
  519.   if ball.Y-1>cspositions[c].Y then
  520.      cspositions[c].Y:=cspositions[c].Y+1+random((ball.Y  - cspositions[c].Y) div 2);
  521.     if (ABS(Ball.X-cspositions[c].X)<2) and (abs(ball.y-cspositions[c].y)<2)
  522.      then
  523.       begin
  524.      Ball.XV:=Ball.XV-random(4);
  525.      Ball.YV:=Ball.YV+random(4)-2;
  526.      if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  527.      if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  528.      end;
  529.    if screen[cspositions[c].x,cspositions[c].y]<>' ' then
  530.    begin
  531.     cspositions[c].X:=ox;
  532.     cspositions[c].Y:=oy;
  533.         placemen;
  534.   end;
  535.  end;
  536. end;
  537.  
  538. Begin
  539.  Ball.X:=40;
  540.  Ball.Y:=5;
  541.  Ball.XV:=0;
  542.  Ball.YV:=0;
  543.  WRITELN('HOW MANY PEOPLE FROM AP ARE PLAYING ?');
  544.  READLN(APGUYS);
  545.  WRITELN('HOW MANY PEOPLE FROM CS2 ARE PLAYING ?');
  546.  READLN(CSGUYS);
  547.  INITPOSITIONS;
  548.  Rescreen;
  549.  placemen;
  550.  MoveBall;
  551.  Dumpscreen;
  552.  Repeat
  553.  apmove;
  554.  csmove;
  555.  Rescreen;
  556.  placemen;
  557.  MoveBall;
  558.  Dumpscreen;
  559.  Delay(1000);
  560.  until keypressed;
  561. end;
  562.  
  563. Procedure PLayGame;
  564. TYPE
  565.  PLACE = RECORD
  566.   X,Y:INTEGER;
  567.  END;
  568. VAR
  569.  APGUYS,CSGUYS:INTEGER;
  570.  APPOSITIONS: ARRAY[1..20] OF PLACE;
  571.  CSPOSITIONS: ARRAY[1..20] OF PLACE;
  572.  
  573. PROCEDURE INITPOSITIONS;
  574. VAR
  575.  c:INTEGER;
  576. BEGIN
  577.  FOR C:=1 TO APGUYS DO
  578.  BEGIN
  579.  APPOSITIONS[C].X:=38;
  580.  APPOSITIONS[C].Y:=C+1;
  581.  END;
  582.  FOR C:=1 TO CSGUYS DO
  583.  BEGIN
  584.  CSPOSITIONS[C].X:=41;
  585.  CSPOSITIONS[C].Y:=c+1;
  586.  END;
  587. END;
  588.  
  589. Procedure Apgoal;
  590. begin
  591. apcsscore:=apcsscore+1;
  592. clrscr;
  593. WRITELN('AP SCORES !');
  594. Delay(1000);
  595. ball.X:=30;
  596. ball.Y:=8;
  597. initpositions;
  598. end;
  599.  
  600. Procedure CSgoal;
  601. begin
  602. csIIscore:=csIIscore+1;
  603. clrscr;
  604. WRITELN('CS SCORES !');
  605. Delay(1000);
  606. ball.X:=70;
  607. ball.Y:=8;
  608. initpositions;
  609. end;
  610.  
  611. Procedure MoveBall;
  612. begin
  613. Ball.X:=(Ball.X+Ball.XV);
  614. Ball.Y:=Ball.Y+Ball.YV;
  615. Ball.XV:=Ball.XV div 2;
  616. Ball.YV:=Ball.YV div 2;
  617. if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  618. if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  619. if screen[ball.x,ball.y]='[' then Apgoal;
  620. if screen[ball.x,ball.y]=']' then CSgoal;
  621. screen[ball.x,ball.y]:='.';
  622. end;
  623.  
  624. Procedure Placemen;
  625. var
  626.  c:integer;
  627. begin
  628.  screen[appositions[1].X,appositions[1].y]:='I';
  629. For c:=2 to apguys do
  630.  screen[APPOSITIONS[C].X,APPOSITIONS[C].Y]:=chr(1);
  631. For c:=1 to csguys do
  632.  screen[CSPOSITIONS[C].X,CSPOSITIONS[C].Y]:=chr(2);
  633. end;
  634.  
  635. Procedure APMOVE;
  636. var
  637.  c:integer;
  638.  ox,oy:integer;
  639. begin
  640.  for c:=2 to APguys do
  641.  begin
  642.   ox:=appositions[c].X;
  643.   oy:=appositions[c].Y;
  644.   if ball.X+1<appositions[c].X then
  645.      appositions[c].X:=appositions[c].X-1-random((appositions[c].X- ball.X)div 2);
  646.   if ball.Y+1<appositions[c].Y then
  647.      appositions[c].Y:=appositions[c].Y-1-random((appositions[c].Y- ball.Y)div 2);
  648.   if ball.X-1>appositions[c].X then
  649.      appositions[c].X:=appositions[c].X+1+random(( ball.X  - appositions[c].X) div 2);
  650.   if ball.Y-1>appositions[c].Y then
  651.      appositions[c].Y:=appositions[c].Y+1+random(( ball.Y  - appositions[c].Y) div 2);
  652.   if (ABS(Ball.X-appositions[c].X)<2) and (abs(ball.y-appositions[c].y)<2)
  653.      then
  654.       begin
  655.      Ball.XV:=Ball.XV-random(4);
  656.      Ball.YV:=Ball.YV+random(4)-2;
  657.      if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  658.      if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  659.      end;
  660.  
  661.   if screen[appositions[c].x,appositions[c].y]<>' ' then
  662.    begin
  663.     appositions[c].X:=ox;
  664.     appositions[c].Y:=oy;
  665.   end;
  666.  placemen;
  667.  end;
  668. end;
  669.  
  670. Procedure CSMOVE;
  671. var
  672.  c:integer;
  673.  ox,oy:integer;
  674. begin
  675.  for c:=1 to CSguys do
  676.  begin
  677.   ox:=cspositions[c].X;
  678.   oy:=cspositions[c].Y;
  679.   if ball.X+1<cspositions[c].X then
  680.      cspositions[c].X:=cspositions[c].X-1-random((cspositions[c].X- ball.X)div 2);
  681.   if ball.Y+1<cspositions[c].Y then
  682.      cspositions[c].Y:=cspositions[c].Y-1-random((cspositions[c].Y- ball.Y)div 2);
  683.   if ball.X-1>cspositions[c].X then
  684.      cspositions[c].X:=cspositions[c].X+1+random((ball.X  - cspositions[c].X) div 2);
  685.   if ball.Y-1>cspositions[c].Y then
  686.      cspositions[c].Y:=cspositions[c].Y+1+random((ball.Y  - cspositions[c].Y) div 2);
  687.     if (ABS(Ball.X-cspositions[c].X)<2) and (abs(ball.y-cspositions[c].y)<2)
  688.      then
  689.       begin
  690.      Ball.XV:=Ball.XV-random(4);
  691.      Ball.YV:=Ball.YV+random(4)-2;
  692.      if (Ball.X>=80) or (Ball.X<=1) then ball.x:=40;
  693.      if (Ball.Y>=16) or (Ball.Y<=1) then ball.Y:=8;
  694.      end;
  695.    if screen[cspositions[c].x,cspositions[c].y]<>' ' then
  696.    begin
  697.     cspositions[c].X:=ox;
  698.     cspositions[c].Y:=oy;
  699.         placemen;
  700.   end;
  701.  end;
  702. end;
  703.  
  704. Procedure Handlebutton;
  705. var
  706.  ch:char;
  707.  ox,oy:integer;
  708. begin
  709. ch:=readkey;
  710.   ox:=appositions[1].X;
  711.   oy:=appositions[1].Y;
  712. if (ch='I') and (appositions[1].y>3) then appositions[1].Y:=appositions[1].Y-2;
  713. if (ch='K') and (appositions[1].y<14) then appositions[1].Y:=appositions[1].Y+2;
  714. if (ch='J') and (appositions[1].X>3) then appositions[1].X:=appositions[1].X-2;
  715. if (ch='L') and (appositions[1].X<14) then appositions[1].X:=appositions[1].X+2;
  716.    if screen[cspositions[1].x,cspositions[1].y]<>' ' then
  717.    begin
  718.     cspositions[1].X:=ox;
  719.     cspositions[1].Y:=oy;
  720.         placemen;
  721.   end;
  722. end;
  723.  
  724. Begin
  725.  Ball.X:=40;
  726.  Ball.Y:=5;
  727.  Ball.XV:=0;
  728.  Ball.YV:=0;
  729.  WRITELN('HOW MANY PEOPLE FROM AP ARE PLAYING ?');
  730.  READLN(APGUYS);
  731.  WRITELN('HOW MANY PEOPLE FROM CS2 ARE PLAYING ?');
  732.  READLN(CSGUYS);
  733.  INITPOSITIONS;
  734.  Rescreen;
  735.  placemen;
  736.  MoveBall;
  737.  Dumpscreen;
  738.  Repeat
  739.  if keypressed then handlebutton;
  740.  apmove;
  741.  csmove;
  742.  Rescreen;
  743.  placemen;
  744.  MoveBall;
  745.  Dumpscreen;
  746.  Delay(1000);
  747.  until apcsscore+csiiscore>10;
  748. end;
  749.  
  750.  
  751. Procedure MainMenu; {procedure with no parameters}
  752. var
  753.  Temp:integer;
  754. begin
  755.  FOR temp:=1 to 25 do Writeln; {fixed repetition loop}
  756.  WRITELN('        ▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌Main Menu▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌▌');
  757.  Writeln;
  758.  Writeln('        [1]....................NerdBowl DataBase');
  759.  Writeln('        [2]....................Watch Simulated Game');
  760.  Writeln('        [3]....................HELP');
  761.  Writeln('        [4]....................Quit');
  762.  Writeln('        [5]....................Play Game');
  763.  Writeln;
  764.  Write('Please enter a choice [1..6]:');
  765.  Readln(temp);
  766.  Case temp of {Here is a case statement}
  767.     1:  DatabaseMenu;
  768.     2:  WatchGame;
  769.     3:  Help;
  770.     4:  halt;
  771.     5:  playgame;
  772.      else
  773.     MainMenu;
  774.     end;
  775. Mainmenu
  776. end;
  777.  
  778. begin
  779. Initialize;
  780. Mainmenu;
  781. end.
  782.